home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tables / ZRBALL.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  4.6 KB  |  183 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 1.1
  3. C---------------------------------------------------------
  4. C
  5. C  ZRBINT - 05 MAR 84
  6. C           TIE LIBRARY
  7. C           TABLES SUPPLEMENTARY LIBRARY
  8. C
  9. C  INITIALISE AN ARRAY AS A RING BUFFER FOR POSSIBLE USE AS
  10. C  A STACK (LIFO) OR QUEUE (FIFO).
  11. C
  12. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' (THE SIZE OF THE ARRAY
  13. C  OR SPECIFIED WIDTH IS WRONG) OR THE MAXIMUM ARRAY DEPTH. THERE IS
  14. C  AN OVERHEAD OF 8 LOCATIONS RESERVED BY THE ROUTINES. NOT ALL THE
  15. C  RESERVED LOCATIONS ARE USED AT PRESENT.
  16. C
  17.       INTEGER FUNCTION ZRBINT(ARRAY, SIZE, WIDTH)
  18.  
  19.       INTEGER SIZE, WIDTH
  20.       INTEGER ARRAY(*)
  21.  
  22.       ZRBINT = -1
  23.       IF(WIDTH .LE. 0)         RETURN
  24.       IF(SIZE  .LT. WIDTH + 8) RETURN
  25.  
  26. C  IDENTIFY THE ARRAY AS A RING BUFFER
  27.       ARRAY(1) = 114
  28. C  THE SIZE OF THE ARRAY
  29.       ARRAY(2) = SIZE
  30. C  THE WIDTH OF EACH ELEMENT
  31.       ARRAY(3) = WIDTH
  32. C  THE MAXIMUM NUMBER OF ELEMENTS THAT CAN BE STORED IN THE BUFFER
  33.       ARRAY(4) = (SIZE - 8) / WIDTH
  34. C  THE NUMBER OF ELEMENTS CURRENTLY STORED IN THE BUFFER
  35.       ARRAY(5) = 0
  36. C  THE LAST  ELEMENT IN THE BUFFER
  37.       ARRAY(6) = 0
  38. C  THE FIRST ELEMENT IN THE BUFFER
  39.       ARRAY(7) = 0
  40. C  UNUSED
  41.       ARRAY(8) = 0
  42.  
  43.       ZRBINT = ARRAY(4)
  44.  
  45.       RETURN
  46.       END
  47. C----------------------------------------------------------------------
  48. C
  49. C  ZRBTYP - 05 MAR 84
  50. C           TIE LIBRARY
  51. C           TABLES SUPPLEMENTARY LIBRARY
  52. C
  53. C  RETURN THE TYPE OF A RING BUFFER
  54. C
  55.       INTEGER FUNCTION ZRBTYP(ARRAY, WIDTH, DEPTH, FREE)
  56.  
  57.       INTEGER WIDTH, DEPTH, FREE
  58.       INTEGER ARRAY(*)
  59.  
  60.       ZRBTYP = -1
  61.       IF(ARRAY(1) .NE. 114) RETURN
  62.  
  63. C  THE WIDTH OF EACH ELEMENT
  64.       WIDTH = ARRAY(3)
  65. C  THE MAXIMUM NUMBER OF ELEMENTS THAT CAN BE STORED IN THE BUFFER
  66.       DEPTH = ARRAY(4)
  67. C  THE NUMBER OF ELEMENTS CURRENTLY STORED IN THE BUFFER
  68.       FREE  = DEPTH - ARRAY(5)
  69.  
  70.       ZRBTYP = -2
  71.  
  72.       RETURN
  73.       END
  74. C----------------------------------------------------------------------
  75. C
  76. C  ZPUSH  - 05 MAR 84
  77. C           TIE LIBRARY
  78. C           TABLES SUPPLEMENTARY LIBRARY
  79. C
  80. C  PUSH AN ELEMENT ON TO THE END OF A RING BUFFER
  81. C
  82. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR 'NOERR'
  83. C
  84.       INTEGER FUNCTION ZPUSH(ELEM, ARRAY)
  85.  
  86.       INTEGER I, OFFSET
  87.       INTEGER ELEM(*), ARRAY(*)
  88.  
  89.       ZPUSH = -1
  90.       IF(ARRAY(1) .NE. 114)     RETURN
  91.       ZPUSH = -100
  92.       IF(ARRAY(5) .GE. ARRAY(4)) RETURN
  93.  
  94. C  THE NUMBER OF ELEMENTS CURRENTLY STORED IN THE BUFFER
  95.       IF(ARRAY(5) .EQ. 0) THEN
  96.         ARRAY(6) = 0
  97.         ARRAY(7) = 1
  98.       ENDIF
  99.       ARRAY(5) = ARRAY(5) + 1
  100.  
  101. C  THE NEXT ELEMENT TO BE ADDED TO THE END
  102.       ARRAY(6) = ARRAY(6) + 1
  103.       IF(ARRAY(6) .GT. ARRAY(4)) ARRAY(6) = 1
  104.       OFFSET = 8 + (ARRAY(3) * (ARRAY(6) - 1))
  105.       DO 10 I = 1, ARRAY(3)
  106.         ARRAY(OFFSET + I) = ELEM(I)
  107.    10 CONTINUE
  108.  
  109.       ZPUSH = -2
  110.  
  111.       RETURN
  112.       END
  113. C----------------------------------------------------------------------
  114. C
  115. C  ZPOP   - 05 MAR 84
  116. C           TIE LIBRARY
  117. C           TABLES SUPPLEMENTARY LIBRARY
  118. C
  119. C  POP AN ELEMENT FROM THE END OF A RING BUFFER USED AS A STACK
  120. C
  121. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR', 'NOERR' OR 'EOF'
  122. C
  123.       INTEGER FUNCTION ZPOP(ELEM, ARRAY)
  124.  
  125.       INTEGER I, OFFSET
  126.       INTEGER ELEM(*), ARRAY(*)
  127.  
  128.       ZPOP = -1
  129.       IF(ARRAY(1) .NE. 114) RETURN
  130.       ZPOP = -100
  131.       IF(ARRAY(5) .LE. 0)    RETURN
  132.  
  133. C  THE NUMBER OF ELEMENTS CURRENTLY STORED IN THE BUFFER
  134.       ARRAY(5) = ARRAY(5) - 1
  135.  
  136. C  THE NEXT ELEMENT TO BE TAKEN FROM THE END
  137.       OFFSET = 8 + (ARRAY(3) * (ARRAY(6) - 1))
  138.       DO 10 I = 1, ARRAY(3)
  139.         ELEM(I) = ARRAY(OFFSET + I)
  140.    10 CONTINUE
  141.       ARRAY(6) = ARRAY(6) - 1
  142.       IF(ARRAY(6) .LE. 0) ARRAY(6) = ARRAY(4)
  143.  
  144.       ZPOP = -2
  145.  
  146.       RETURN
  147.       END
  148. C----------------------------------------------------------------------
  149. C
  150. C  ZRBGET  - 05 MAR 84
  151. C           TIE LIBRARY
  152. C           TABLES SUPPLEMENTARY LIBRARY
  153. C
  154. C  TAKE AN ELEMENT FROM THE END OF A RING BUFFER USED AS A QUEUE
  155. C
  156. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR', 'NOERR' OR 'EOF'
  157. C
  158.       INTEGER FUNCTION ZRBGET(ELEM, ARRAY)
  159.  
  160.       INTEGER I, OFFSET
  161.       INTEGER ELEM(*), ARRAY(*)
  162.  
  163.       ZRBGET = -1
  164.       IF(ARRAY(1) .NE. 114) RETURN
  165.       ZRBGET = -100
  166.       IF(ARRAY(5) .LE. 0)    RETURN
  167.  
  168. C  THE NUMBER OF ELEMENTS CURRENTLY STORED IN THE BUFFER
  169.       ARRAY(5) = ARRAY(5) - 1
  170.  
  171. C  THE NEXT ELEMENT TO BE TAKEN FROM THE END
  172.       OFFSET = 8 + (ARRAY(3) * (ARRAY(7) - 1))
  173.       DO 10 I = 1, ARRAY(3)
  174.         ELEM(I) = ARRAY(OFFSET + I)
  175.    10 CONTINUE
  176.       ARRAY(7) = ARRAY(7) + 1
  177.       IF(ARRAY(7) .GT. ARRAY(4)) ARRAY(7) = 1
  178.  
  179.       ZRBGET = -2
  180.  
  181.       RETURN
  182.       END
  183.